{ *******************************************************************************
  *                                                                             *
  *          Mathengine                                                         *
  *                                                                             *
  *          (C)Copyright Jimx 2011                                             *
  *                                                                             *
  *          http://math-engine.googlecode.com                                  *
  *                                                                             *
  *******************************************************************************
  *  This file is part of Mathengine.                                           *
  *                                                                             *
  *  Mathengine is free software:                                               *
  *  you can redistribute it and/or modify                                      *
  *  it under the terms of the GNU General Public License as published by       *
  *  the Free Software Foundation, either version 3 of the License, or          *
  *  (at your option) any later version.                                        *
  *                                                                             *
  *  Mathengine is distributed                                                  *
  *  in the hope that it will be useful,                                        *
  *  but WITHOUT ANY WARRANTY; without even the implied warranty of             *
  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *
  *  GNU General Public License for more details.                               *
  *                                                                             *
  *  You should have received a copy of the GNU General Public License          *
  *  along with Mathengine.                                                     *
  *  If not, see <http://www.gnu.org/licenses/>.                                *
  ******************************************************************************* }
unit sci.config;

(* unit_Config provides some function of parsing config files *)
interface

uses
  Windows, SysUtils, Classes, sci.log, Generics.Collections, math.global;

type
  TConfToken = (TOK_EQU, TOK_NUM, TOK_STR, TOK_LPAREN, TOK_RPAREN,
    TOK_EOF, TOK_ERR);

  TConfParamType = (PARAM_NUM, PARAM_STR, PARAM_LIST);

  PConfParam = ^TConfParam;

  TConfParam = record
    typ: TConfParamType;

    i: integer;
    str: string;
    list: TList<TConfParam>;
  end;

  TConfHandler = procedure(var data: TConfParam);

  TConf = record
    name: string;
    data: TConfParam;
    handler: TConfHandler; (* custom handler, it will be called as soon as
      data becomes set *)
  end;

  TConfList = TList<TConf>;

function NewConf(name: string): TConf; overload;
function NewConf(name: string; handler: TConfHandler): TConf; overload;
function NewConfList: TConfList;
procedure AddToConfList(var cl: TConfList; cf: TConf);
function LookUpConf(cl: TConfList; name: string): integer;
procedure ParseConf(var cl: TConfList; filename: string);

function TYPEOF(cl: TConfList; name: string): TConfParamType; inline;
function INTVALUE(cl: TConfList; name: string): integer; inline;
function STRVALUE(cl: TConfList; name: string): string; inline;
procedure intlist(cl: TConfList; name: string; var list: TList<integer>);
procedure strlist(cl: TConfList; name: string; var list: TList<String>);
procedure dumplist(cl: TConfList; name: string);

implementation

(*
procedure test;
var
  cl: TConfList;
begin
  AddToConfList(cl, NewConf('a'));
  AddToConfList(cl, NewConf('b'));
  AddToConfList(cl, NewConf('c'));
  ParseConf(cl, 'test.conf');
  log(IntToStr(INTVALUE(cl, 'a')));
  log(STRVALUE(cl, 'b'));
  dumplist(cl, 'c');
end;
*)

function NewConf(name: string): TConf;
begin
  Result.name := name;
end;

function NewConf(name: string; handler: TConfHandler): TConf;
begin
  Result.name := name;
  Result.handler := handler;
end;

function NewConfList: TConfList;
begin
  Result := TList<TConf>.Create;
end;

procedure AddToConfList(var cl: TConfList; cf: TConf);
begin
  cl.Add(cf);
end;

function LookUpConf(cl: TConfList; name: string): integer;
var
  i: integer;
begin
  for i := 0 to cl.Count - 1 do
  begin
    if cl[i].name = name then
    begin
      exit(i);
    end;
  end;
  exit(-1);
end;

procedure ParseConf(var cl: TConfList; filename: string);
const
  CR = #13;
  LF = #10;
  TAB = #8;
  SPACE = ' ';
var
  fconf: TFileStream;
  tok: TConfToken;
  last_string: string;
  last_number: integer;
  last_char: char;
  confidx: integer;
  tmppar: TConfParam;
  tmp: TConf;

  function isalpha(c: char): boolean;
  begin
    Result := ((c >= 'A') and (c <= 'Z')) or ((c >= 'a') and (c <= 'z'));
  end;

  function isdigit(c: char): boolean;
  begin
    Result := ((c >= '0') and (c <= '9'));
  end;

  function isalnum(c: char): boolean;
  begin
    Result := isalpha(c) or isdigit(c);
  end;

  function getc: char;
  var
    b: byte;
  begin
    if fconf.Position = fconf.Size then
      exit(char(-1));
    fconf.Read(b, 1);
    exit(char(b));
  end;

  function read_token: TConfToken;
  begin
    last_number := 0;
    last_string := '';
    (* Skip CR, LF, tab and space *)
    while ((last_char = CR) or (last_char = LF) or (last_char = TAB) or
      (last_char = SPACE)) do
      last_char := getc;

    (* string *)
    if isalpha(last_char) then
    begin
      while (isalnum(last_char) or (last_char = '.') or (last_char = '_')) do
      begin
        last_string := last_string + last_char;
        last_char := getc;
      end;
      exit(TOK_STR);
    end;

    (* number *)
    if (isdigit(last_char)) then
    begin
      while (isdigit(last_char)) do
      begin
        last_number := last_number * 10 + (ord(last_char) - 48);
        last_char := getc;
      end;
      exit(TOK_NUM);
    end;

    (* '=' *)
    if (last_char = '=') then
    begin
      last_char := getc;
      exit(TOK_EQU);
    end;

    (* '(' *)
    if (last_char = '(') then
    begin
      last_char := getc;
      exit(TOK_LPAREN);
    end;

    (* ')' *)
    if (last_char = ')') then
    begin
      last_char := getc;
      exit(TOK_RPAREN);
    end;

    if (last_char = char(-1)) then
    begin
      exit(TOK_EOF);
    end;

    exit(TOK_ERR);
  end;

  function match_tok(expected: TConfToken): boolean;
  begin
    if tok = expected then
    begin
      tok := read_token;
      exit(true);
    end
    else
    begin
      Exception.Create('unexpected token');
      exit(false);
    end;
  end;

begin
  try
    fconf := TFileStream.Create(filename, fmOpenRead);
    fconf.Position := 0;
  except
    raise Exception.Create('failed to open config file');
  end;

  last_char := getc;
  tok := read_token;
  while true do
  begin
    if (tok = TOK_EOF) then
      break;
    if (tok = TOK_ERR) then
      raise Exception.Create('unknown token');

    if (tok <> TOK_STR) then
      raise Exception.Create('unexpected token');
    confidx := LookUpConf(cl, last_string);
    if (confidx = -1) then
    begin
      match_tok(TOK_STR);
      match_tok(TOK_EQU);
      match_tok(tok);
      continue;
    end;

    match_tok(TOK_STR);
    match_tok(TOK_EQU);

    if (tok = TOK_NUM) then (* number *)
    begin
      tmp := cl[confidx];
      tmp.data.typ := PARAM_NUM;
      tmp.data.i := last_number;
      if (@tmp.handler <> nil) then
        tmp.handler(tmp.data);
      cl.Delete(confidx);
      cl.Add(tmp);
    end
    else if (tok = TOK_STR) then (* string *)
    begin
      tmp := cl[confidx];
      tmp.data.typ := PARAM_STR;
      tmp.data.str := last_string;
      if (@tmp.handler <> nil) then
        tmp.handler(tmp.data);
      cl.Delete(confidx);
      cl.Add(tmp);
    end
    else if (tok = TOK_LPAREN) then (* list *)
    begin
      match_tok(TOK_LPAREN);
      tmp := cl[confidx];
      tmp.data.typ := PARAM_LIST;
      tmp.data.list := TList<TConfParam>.Create;
      while (tok <> TOK_RPAREN) do
      begin
        if (tok = TOK_NUM) then (* number *)
        begin
          tmppar.typ := PARAM_NUM;
          tmppar.i := last_number;
          tmp.data.list.Add(tmppar);
        end
        else if (tok = TOK_STR) then (* string *)
        begin
          tmppar.typ := PARAM_STR;
          tmppar.str := last_string;
          tmp.data.list.Add(tmppar);
        end;
        match_tok(tok);
      end;
      if (@tmp.handler <> nil) then
        tmp.handler(tmp.data);
      cl.Delete(confidx);
      cl.Add(tmp);
    end;
    match_tok(tok);
  end;
end;

function TYPEOF(cl: TConfList; name: string): TConfParamType; inline;
begin
  exit(cl[LookUpConf(cl, name)].data.typ);
end;

function INTVALUE(cl: TConfList; name: string): integer; inline;
begin
  exit(cl[LookUpConf(cl, name)].data.i);
end;

function STRVALUE(cl: TConfList; name: string): string; inline;
begin
  exit(cl[LookUpConf(cl, name)].data.str);
end;

procedure intlist(cl: TConfList; name: string; var list: TList<integer>);
var
  i: integer;
  confidx: integer;
begin
  confidx := LookUpConf(cl, name);
  if confidx = -1 then
    exit;

  for i := 0 to cl[confidx].data.list.Count - 1 do
  begin
    list.Add(cl[confidx].data.list[i].i);
  end;
end;

procedure strlist(cl: TConfList; name: string; var list: TList<String>);
var
  i: integer;
  confidx: integer;
begin
  confidx := LookUpConf(cl, name);
  if confidx = -1 then
    exit;

  for i := 0 to cl[confidx].data.list.Count - 1 do
  begin
    list.Add(cl[confidx].data.list[i].str);
  end;
end;

procedure dumplist(cl: TConfList; name: string);
var
  i: integer;
begin
  (* tmp := LookUpConf(cl, name);
    if tmp = nil then exit;

    for i := 0 to tmp.data.list.Count - 1 do
    begin
    if tmp.data.list[i].typ = PARAM_NUM then
    log(format('%s[%d]: %d', [name, i, tmp.data.list[i].i]))
    else if tmp.data.list[i].typ = PARAM_STR then
    log(format('%s[%d]: %s', [name, i, tmp.data.list[i].str]))
    end; *)
end;

end.
